home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops ƒ / String < prev    next >
Text File  |  1998-07-27  |  8KB  |  314 lines
  1. \ String class.
  2.  
  3. cr .( loading String...)
  4.  
  5. \ This class is changed radically from Neon!  We now keep two offsets into a string
  6. \ - POS and LIM.  POS marks the "current" position, and LIM the "current" end.
  7. \ Most string operations operate on the substring delimited by POS and LIM, which
  8. \ we call the active part of the string. We also keep the size of the string (the
  9. \ real size, that is) in an ivar, so that we can get it quickly without a system
  10. \ call.
  11.  
  12.    $ D    constant    RET            \ Carriage return character
  13.  
  14. : $ER
  15.     setFwind
  16.     cr ." size: " .  ."   pos: " .  ."   lim: " .
  17.     89 die   ;
  18.  
  19. ' $er  -> $err
  20.  
  21. : $=  { addr1 len1 addr2 len2 -- }
  22.     word0  addr1  addr2  len1  len2  pack  w 10
  23.     trap$ a9ed                                \ IUMagString
  24.     i->l  ;
  25.  
  26.  
  27. : NOPEN    ." (not open)"  ;
  28.  
  29.  
  30. :class    STRING    super{ handle }        general
  31.  
  32. record
  33. {    var    SIZE
  34.     var    POS
  35.     var    LIM
  36.     int    FLAGS
  37. }
  38.  
  39. :m COPYTO:    \ Redefinition of COPYTO: which will disallow a size change
  40.             \ on the copy.  I found it was fairly easy to do this
  41.             \ accidentally, and get into random crash territory.
  42.     copyto: super
  43.     1 put: flags   ;m
  44.  
  45.  
  46. :m MARK_ORIGINAL:
  47. \ Overrides the above check.  Marks a copy as original, so we can change its
  48. \ size.  We hope we know what we're doing.  At least this is a long name
  49. \ which could hardly get typed by accident!!
  50.  
  51.     clear: flags   ;m
  52.  
  53.  
  54. :m HANDLE:        \ this method returns the handle - replaces get: in super
  55.     inline{ obj @}  ;m
  56.  
  57. :m POS:        \ ( -- pos )
  58.     inline{ get: pos}  ;m
  59.  
  60. :m >POS:    \ ( newpos -- )
  61.     inline{ put: pos}  ;m
  62.  
  63. :m LIM:        \ ( -- lim )
  64.     inline{ get: lim}  ;m
  65.  
  66. :m >LIM:    \ ( newlim -- )
  67.     inline{ put: lim}  ;m
  68.  
  69. :m LEN:        \ ( -- length )
  70.     get: lim  get: pos  -   ;m
  71.  
  72. :m >LEN:    \ ( newlength -- )
  73.     get: pos  +  put: lim  ;m
  74.  
  75.  
  76. :m SKIP:    \ ( n -- )  Increments POS by n.
  77.     inline{ +: pos}  ;m
  78.  
  79. :m MORE:    \ ( n -- )  Increments LIM by n.
  80.     inline{ +: lim}  ;m
  81.  
  82. :m START:    \ Sets POS to 0 (the start of the string).
  83.     inline{ clear: pos}  ;m
  84.  
  85. :m BEGIN:    \ Sets POS and LIM to 0, ready to begin some operation.
  86.     clear: pos  clear: lim   ;m
  87.  
  88. :m END:        \ Sets POS and LIM to the end of the string.
  89.     get: size  dup  put: pos  put: lim  ;m
  90.  
  91. :m NOLIM:    \ Sets LIM to the end of the string.
  92.     inline{ get: size put: lim}  ;m
  93.  
  94. :m RESET:    \ Sets POS to 0, and LIM to the end.
  95.     inline{ clear: pos  get: size  put: lim}  ;m
  96.  
  97. :m STEP:    \ Steps down the string, by setting POS to LIM and
  98.             \ then setting LIM to the end.
  99.     get: lim  put: pos  get: size  put: lim  ;m
  100.  
  101. :m <STEP:    \ Backward step.  Sets LIM to POS, then POS to 0.
  102.     get: pos  put: lim  clear: pos  ;m
  103.  
  104.  
  105. :m NEW:
  106.     0 new: super
  107.     clear: size  clear: pos  clear: lim  clear: flags  ;m
  108.     
  109. :m ?NEW:
  110.     ^base @  nilH <> ?EXIT  new: self  ;m
  111.  
  112. :m SIZE:    \ ( -- size )
  113.     inline{ get: size}  ;m
  114.  
  115. :m SETSIZE:    \ ( newsize -- )
  116.     get: flags  ?error 94        \ Can't do that on a string copy
  117.     ?new: self
  118.     dup  setsize: super  put: size  reset: self  ;m
  119.  
  120. :m CLEAR:
  121.     ?new: self  0 setsize: self  ;m
  122.  
  123. :m GET:        \ ( -- addr len ).  Gets the active part of the string.
  124.     $chk
  125.     ptr: self  get: pos  +  get: lim  get: pos  -  ;m
  126.  
  127. :m ALL:        \ ( -- addr len )    Gets all the string, ignoring POS and LIM.
  128.     ptr: self  size: self  ;m
  129.  
  130. :m 1ST:        \ ( -- c )  Returns the char at POS.
  131.     ptr: self  get: pos  +  c@  ;m
  132.  
  133. :m ^1ST:    \ ( -- addr )  Returns the addr of the char at POS.
  134.     ptr: self  get: pos  +  ;m
  135.  
  136. private
  137.  
  138. :m MUNGER:  { addr1 len1 addr2 len2 -- offs }
  139.         \ Interface to the Toolbox Munger utility
  140.     $chk
  141.     get: flags  ?error 94        \ Can't do that on a string copy
  142.        0                            \ For returned result
  143.     ^base @  get: pos
  144.     addr1 len1  addr2 len2
  145.     trap$ a9e0                    \ call Munger
  146.     size: super  put: size  ;m
  147.  
  148. public
  149.  
  150. :m UC:        \ ( -- addr len )  Converts string to upper case and gets it.
  151.     get: self  2dup  upper  ;m
  152.  
  153.  
  154. :m PUT: { addr len -- }
  155.         \ Replaces entire string with replacement string.  Does NEW:
  156.         \ if not already done.
  157.     ?new: self  clear: pos
  158.     0 -1  addr len  munger: self  put: lim  ;m
  159.  
  160. :m ->:  { str \ state -- }
  161.         \ Replaces self with the active part of string str.  We assume
  162.         \ the type, and early bind.  As the replacement may cause the
  163.         \ Mem Manager to move things, we lock str for the duration.
  164.  
  165.     str getState: string  -> state   str lock: string
  166.     str get: string   put: self
  167.     state   str setState: string   ;m
  168.  
  169.     
  170. :m INSERT:  { addr len -- }
  171.     ?new: self
  172.     addr 0 addr len  munger: self  put: pos
  173.     len +: lim  ;m
  174.  
  175.  
  176. :m $INSERT:  { str \ state -- }
  177.         \ Inserts the active text from the given relocatable
  178.         \ string, using early binding.  As the memory manager could 
  179.         \ move the source string to make room for the increase in 
  180.         \ length of SELF, we lock the source string for the
  181.         \ operation, then restore its previous state.
  182.  
  183.     str getState: string  -> state  str lock: string
  184.     str get: string  insert: self
  185.     state  str setState: string  ;m
  186.  
  187.  
  188. :m ADD: { addr len -- }
  189.     end: self
  190.     addr len  insert: self  ;m
  191.  
  192.  
  193. :m $ADD:  { str \ state -- }
  194.     str getState: string  -> state  str lock: string
  195.     str get: string  add: self
  196.     state  str setState: string  ;m
  197.  
  198.  
  199. :m +:        \ ( char -- )  Appends a char to end of string
  200.     pad c!  pad 1 add: self  ;m
  201.  
  202.  
  203. :m PRINT:
  204.     nil?: self
  205.     if   Nopen  else   get: self  type   then   ;m
  206.  
  207. \ :m   =: { theobj -- }
  208. \        \ Assigns this string to any object that accepts ( addr len )
  209. \    get: self  put: theobj  ;m
  210.  
  211. :m FILL:    \ ( c -- )
  212.     get: self  rot  fill  ;m
  213.  
  214.  
  215. \ SEARCH: and CHSEARCH: are somewhat interim.  Class String+ provides more
  216. \ efficient versions which also include case handling.  But these versions
  217. \ are short, and may be adequate for many needs.
  218.  
  219. :m SEARCH:    \ ( addr len -- b )
  220.     0 0  munger: self
  221.     dup 0< if  drop  false  else  put: lim  true  then  ;m
  222.  
  223. :m CHSEARCH:    \ ( c -- b )
  224.     pad c!  pad 1  search: self  ;m
  225.  
  226.  
  227.  
  228. \        =========== Stream operations ===========
  229.  
  230. (*    The stream methods READ: and WRITE: are meant to look the same
  231.     for both strings and files (and for anything else we think
  232.     of later).  By late binding to an object that supports these,
  233.     we don't have to know or care exactly what it is.  It gives
  234.     us bytes or accepts bytes, and tells us whether it was
  235.     successful, and that's all we have to worry about.  This is
  236.     really a "stream interface" idea -- although we don't have
  237.     a formal interface mechanism in Mops, we can use the idea
  238.     whenever it's useful.
  239.     
  240.     For READ:, we only use the active part of the string.  We
  241.     update POS by the number of bytes transferred.  If we 
  242.     transfer the number asked for, we return a "no error"
  243.     code of zero, otherwise -1.  (We don't use true and false 
  244.     so as to behave the same way as files).  WRITE: is
  245.     basically the same as ADD:.  There's no way this can fail
  246.     unless we run out of memory, so we always return zero.
  247. *)
  248.  
  249. :m READ:  { addr len \ #transferred -- code }
  250.     get: self  len min  -> #transferred
  251.     addr  #transferred  move
  252.     #transferred  skip: self
  253.     #transferred  len  <>
  254. ;m
  255.  
  256. :m WRITE:  ( addr len -- code )
  257.     add: self  0  ;m        \ ASSERT{ this op always succeeds! }    :-)
  258.  
  259.  
  260. \        =========== Serialization ===========
  261.  
  262. \ for send: and bring:, we don't call super, since we don't need
  263. \  the handle saved.  In particular, we don't want it brought back!
  264.  
  265. :m SEND:  { stream -- }
  266.     lock: self
  267.     ^base 4+  14  write: [ stream ]  OK?
  268.     all: self  write: [ stream ]  OK?
  269.     unlock: self
  270. ;m
  271.  
  272. :m BRING:  { stream -- }
  273.     ?new: self        \ we do this first, as it can clear pos and lim!
  274.     ^base 4+  14  read: [ stream ]  OK?
  275. \ now the size ivar should be right...
  276.     size: self  ^base  setsize: class_as> handle
  277.     lock: self
  278.     all: self  read: [ stream ]  OK?
  279.     unlock: self
  280. ;m
  281.  
  282.  
  283. :m DUMP:  { \ offs svCurs -- }
  284.     nil?: self  if  Nopen  EXIT  THEN
  285.     curs -> svCurs  -curs
  286.     all: self  swap .h .h  5 spaces
  287.     ." pos: "  pos: self .h  2 spaces
  288.     ." lim: "  lim: self .h  cr
  289.     pos: self 5 - 0 max  -> offs
  290.     all: self  swap offs +  swap offs -  80 min  bounds
  291.     DO  i c@  bl 126 within?
  292.         NIF  ret = IF  $ A6  ELSE  $ D7  THEN
  293.         THEN
  294.         emit
  295.     LOOP  cr
  296.     pos: self  offs - spaces  & P  emit  cr
  297.     lim: self  offs -
  298.     dup 80 < IF  spaces  & L  emit  ELSE  drop  THEN
  299.     ^1st: self  len: self  0 max  $ 140  min  dump
  300.     svCurs -> curs  ;m
  301.  
  302. :m RD:    reset: self  dump: self  ;m        \ Handy, and short to type!
  303.  
  304. ;class
  305.  
  306. <" Files
  307.  
  308. +echo
  309.  
  310. : q db
  311.     temp{ string s }
  312.     " hello" put: s
  313.     dump: s  ;
  314.